Sprite 1984 - 1993/Sprite 1984 - 1993.iso/src/lib/tcl/dist6.3/tests/open.test

Text File | 1992-03-25 | 16.1 KB | 512 lines

# Commands covered:  open, close, gets, puts, read, seek, tell, eof, flush
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright 1991 Regents of the University of California
# Permission to use, copy, modify, and distribute this
# software and its documentation for any purpose and without
# fee is hereby granted, provided that this copyright notice
# appears in all copies.  The University of California makes no
# representations about the suitability of this software for any
# purpose.  It is provided "as is" without express or implied
# warranty.
#
# $Header: /user6/ouster/tcl/tests/RCS/open.test,v 1.12 92/03/25 11:15:52 ouster Exp $ (Berkeley)

if {[string compare test [info procs test]] == 1} then {source defs}

catch {exec rm -f test1 test2 test3}
exec cat > test1 << "Two lines: this one\nand this one\n"
exec cat > test2 << "line1\nline2\nline3\nline4\nline5\n"

test open-1.1 {open command (files only)} {
    set f [open test1]
    set x [gets $f]
    close $f
    set x
} {Two lines: this one}
test open-1.2 {open command (files only)} {
    set f [open test1]
    set f2 [open test2]
    set f3 [open test1]
    set f4 [open test1]
    set x [list [gets $f] [gets $f2] [gets $f3] [gets $f4] \
        [gets $f] [gets $f2]]
    close $f
    close $f2
    close $f3
    close $f4
    set x
} {{Two lines: this one} line1 {Two lines: this one} {Two lines: this one} {and this one} line2}
test open-1.3 {open command (files only)} {
    set f [open test3 w]
    puts $f xyz
    close $f
    exec cat test3
} "xyz"
test open-1.4 {open command (files only)} {
    set f [open test3 w]
    puts $f xyz
    close $f
    set f [open test3 a]
    puts $f 123
    close $f
    exec cat test3
} "xyz\n123"
test open-1.5 {open command (files only)} {
    set f [open test3 w]
    puts $f xyz\n123
    close $f
    set f [open test3 r+]
    set x [gets $f]
    seek $f 0 current
    puts $f 456
    close $f
    list $x [exec cat test3]
} "xyz {xyz
456}"
test open-1.6 {open command (files only)} {
    set f [open test3 w]
    puts $f xyz\n123
    close $f
    set f [open test3 w+]
    puts $f xyzzy
    seek $f 2
    set x [gets $f]
    close $f
    list $x [exec cat test3]
} "zzy xyzzy"
test open-1.7 {open command (files only)} {
    set f [open test3 w]
    puts $f xyz\n123
    close $f
    set f [open test3 a+]
    puts $f xyzzy
    flush $f
    set x [tell $f]
    seek $f -4 cur
    set y [gets $f]
    close $f
    list $x [exec cat test3] $y
} {14 {xyz
123
xyzzy} zzy}

test open-2.1 {errors in open command} {
    list [catch {open} msg] $msg
} {1 {wrong # args: should be "open filename ?access?"}}
test open-2.2 {errors in open command} {
    list [catch {open a b c} msg] $msg
} {1 {wrong # args: should be "open filename ?access?"}}
test open-2.3 {errors in open command} {
    list [catch {open test1 x} msg] $msg
} {1 {illegal access mode "x"}}
test open-2.4 {errors in open command} {
    list [catch {open test1 rw} msg] $msg
} {1 {illegal access mode "rw"}}
test open-2.5 {errors in open command} {
    list [catch {open test1 r+1} msg] $msg
} {1 {illegal access mode "r+1"}}
test open-2.6 {errors in open command} {
    string tolower [list [catch {open _non_existent_} msg] $msg $errorCode]
} {1 {couldn't open "_non_existent_": no such file or directory} {unix enoent {no such file or directory}}}

if {![file exists ~/_test_] && [file writable ~]} {
    test open-3.1 {tilde substitution in open} {
    set f [open ~/_test_ w]
    puts $f "Some text"
    close $f
    set x [file exists $env(HOME)/_test_]
    exec rm -f $env(HOME)/_test_
    set x
    } 1
}
test open-3.2 {tilde substitution in open} {
    set home $env(HOME)
    unset env(HOME)
    set x [list [catch {open ~/foo} msg] $msg]
    set env(HOME) $home
    set x
} {1 {couldn't find HOME environment variable to expand "~/foo"}}

test open-4.1 {file id parsing errors} {
    list [catch {eof gorp} msg] $msg $errorCode
} {1 {bad file identifier "gorp"} NONE}
test open-4.2 {file id parsing errors} {
    list [catch {eof filex} msg] $msg
} {1 {bad file identifier "filex"}}
test open-4.3 {file id parsing errors} {
    list [catch {eof file12a} msg] $msg
} {1 {bad file identifier "file12a"}}
test open-4.4 {file id parsing errors} {
    list [catch {eof file123} msg] $msg
} {1 {file "file123" isn't open}}
test open-4.5 {file id parsing errors} {
    list [catch {eof file1} msg] $msg
} {0 0}
test open-4.5 {file id parsing errors} {
    list [catch {eof stdin} msg] $msg
} {0 0}
test open-4.6 {file id parsing errors} {
    list [catch {eof stdout} msg] $msg
} {0 0}
test open-4.7 {file id parsing errors} {
    list [catch {eof stderr} msg] $msg
} {0 0}
test open-4.8 {file id parsing errors} {
    list [catch {eof stderr1} msg] $msg
} {1 {bad file identifier "stderr1"}}
set f [open test1]
close $f
set expect "1 {file \"$f\" isn't open}"
test open-4.9 {file id parsing errors} {
    list [catch {eof $f} msg] $msg
} $expect

test open-5.1 {close command (files only)} {
    list [catch {close} msg] $msg $errorCode
} {1 {wrong # args: should be "close fileId"} NONE}
test open-5.2 {close command (files only)} {
    list [catch {close a b} msg] $msg $errorCode
} {1 {wrong # args: should be "close fileId"} NONE}
test open-5.3 {close command (files only)} {
    list [catch {close gorp} msg] $msg $errorCode
} {1 {bad file identifier "gorp"} NONE}
test open-5.4 {close command (files only)} {
    list [catch {close file4} msg] \
        [string range $msg [string first {" } $msg] end] $errorCode
} {1 {" isn't open} NONE}

test open-6.1 {puts command} {
    list [catch {puts file3} msg] $msg $errorCode
} {1 {wrong # args: should be "puts fileId string ?nonewline?"} NONE}
test open-6.2 {puts command} {
    list [catch {puts a b c d} msg] $msg $errorCode
} {1 {wrong # args: should be "puts fileId string ?nonewline?"} NONE}
test open-6.3 {puts command} {
    list [catch {puts a b nonewlinx} msg] $msg $errorCode
} {1 {bad argument "nonewlinx": should be "nonewline"} NONE}
test open-6.4 {puts command} {
    list [catch {puts gorp "New text"} msg] $msg $errorCode
} {1 {bad file identifier "gorp"} NONE}
test open-6.5 {puts command} {
    set f [open test3]
    set x [list [catch {puts $f "New text"} msg] \
    [string range $msg [string first " " $msg] end] $errorCode]
    close $f
    set x
} {1 { wasn't opened for writing} NONE}
test open-6.6 {puts command} {
    set f [open test3 w]
    puts $f "Text1" n
    puts $f " Text 2" no
    puts $f " Text 3"
    close $f
    exec cat test3
} {Text1 Text 2 Text 3}

test open-7.1 {gets command} {
    list [catch {gets} msg] $msg $errorCode
} {1 {wrong # args: should be "gets fileId ?varName?"} NONE}
test open-7.2 {gets command} {
    list [catch {gets a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "gets fileId ?varName?"} NONE}
test open-7.3 {gets command} {
    list [catch {gets a} msg] $msg $errorCode
} {1 {bad file identifier "a"} NONE}
test open-7.4 {gets command} {
    set f [open test3 w]
    set x [list [catch {gets $f} msg] \
        [string range $msg [string first " " $msg] end] $errorCode]
    close $f
    set x
} {1 { wasn't opened for reading} NONE}
set f [open test3 w]
puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" nonewline
puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" nonewline
puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" nonewline
puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" nonewline
puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
close $f
test open-7.5 {gets command with long line} {
    set f [open test3]
    set x [gets $f]
    close $f
    set x
} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test open-7.6 {gets command with long line} {
    set f [open test3]
    set x [gets $f y]
    close $f
    list $x $y
} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test open-7.7 {gets command and end of file} {
    set f [open test3 w]
    puts $f "Test1\nTest2" nonewline
    close $f
    set f [open test3]
    set x {}
    set y {}
    lappend x [gets $f y] $y
    set y {}
    lappend x [gets $f y] $y
    set y {}
    lappend x [gets $f y] $y
    close $f
    set x
} {5 Test1 5 Test2 -1 {}}
set f [open test3 w]
puts $f "Line 1"
puts $f "Line 2"
test open-7.8 {gets command and bad variable} {
    catch {unset x}
    set x 24
    set f [open test3 r]
    set result [list [catch {gets $f x(0)} msg] $msg]
    close $f
    set result
} {1 {can't set "x(0)": variable isn't array}}

test open-8.1 {read command} {
    list [catch {read} msg] $msg $errorCode
} {1 {wrong # args: should be "read fileId ?numBytes|nonewline?"} NONE}
test open-8.2 {read command} {
    list [catch {read a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "read fileId ?numBytes|nonewline?"} NONE}
test open-8.3 {read command} {
    list [catch {read file10} msg] $msg $errorCode
} {1 {file "file10" isn't open} NONE}
test open-8.4 {read command} {
    set f [open test3 w]
    set x [list [catch {read $f} msg] \
        [string range $msg [string first " " $msg] end] $errorCode]
    close $f
    set x
} {1 { wasn't opened for reading} NONE}
test open-8.5 {read command} {
    set f [open test1]
    set x [list [catch {read $f 12z} msg] $msg $errorCode]
    close $f
    set x
} {1 {expected integer but got "12z"} NONE}
test open-8.6 {read command} {
    set f [open test1]
    set x [list [catch {read $f z} msg] $msg $errorCode]
    close $f
    set x
} {1 {bad argument "z": should be "nonewline"} NONE}
test open-8.7 {read command} {
    set f [open test1]
    set x [list [read $f 1] [read $f 2] [read $f]]
    close $f
    set x
} {T wo { lines: this one
and this one
}}
test open-8.8 {read command, with over-large count} {
    set f [open test1]
    set x [read $f 100]
    close $f
    set x
} {Two lines: this one
and this one
}
test open-8.9 {read command, nonewline option} {
    set f [open test1]
    set x [read $f n]
    close $f
    set x
} {Two lines: this one
and this one}

test open-9.1 {seek command} {
    list [catch {seek foo} msg] $msg $errorCode
} {1 {wrong # args: should be "seek fileId offset ?origin?"} NONE}
test open-9.2 {seek command} {
    list [catch {seek foo a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "seek fileId offset ?origin?"} NONE}
test open-9.3 {seek command} {
    list [catch {seek foo 0} msg] $msg $errorCode
} {1 {bad file identifier "foo"} NONE}
test open-9.4 {seek command} {
    set f [open test2]
    set x [list [catch {seek $f xyz} msg] $msg $errorCode]
    close $f
    set x
} {1 {expected integer but got "xyz"} NONE}
test open-9.5 {seek command} {
    set f [open test2]
    set x [list [catch {seek $f 100 gorp} msg] $msg $errorCode]
    close $f
    set x
} {1 {bad origin "gorp": should be start, current, or end} NONE}
set f [open test3 w]
puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" nonewline
close $f
test open-9.6 {seek command} {
    set f [open test3]
    set x [read $f 1]
    seek $f 3
    lappend x [read $f 1]
    seek $f 0 start
    lappend x [read $f 1]
    seek $f 10 current
    lappend x [read $f 1]
    seek $f -2 end
    lappend x [read $f 1]
    seek $f 50 end
    lappend x [read $f 1]
    seek $f 1
    lappend x [read $f 1]
    close $f
    set x
} {a d a l Y {} b}

test open-10.1 {tell command} {
    list [catch {tell} msg] $msg $errorCode
} {1 {wrong # args: should be "tell fileId"} NONE}
test open-10.2 {tell command} {
    list [catch {tell a b} msg] $msg $errorCode
} {1 {wrong # args: should be "tell fileId"} NONE}
test open-10.3 {tell command} {
    list [catch {tell a} msg] $msg $errorCode
} {1 {bad file identifier "a"} NONE}
test open-10.4 {tell command} {
    set f [open test2]
    set x [tell $f]
    read $f 3
    lappend x [tell $f]
    seek $f 2
    lappend x [tell $f]
    seek $f 10 current
    lappend x [tell $f]
    seek $f 0 end
    lappend x [tell $f]
    close $f
    set x
} {0 3 2 12 30}

test open-11.1 {eof command} {
    list [catch {eof} msg] $msg $errorCode
} {1 {wrong # args: should be "eof fileId"} NONE}
test open-11.2 {eof command} {
    list [catch {eof a b} msg] $msg $errorCode
} {1 {wrong # args: should be "eof fileId"} NONE}
test open-11.3 {eof command} {
    list [catch {eof file100} msg] $msg $errorCode
} {1 {file "file100" isn't open} NONE}
test open-11.4 {eof command} {
    set f [open test1]
    set x [eof $f]
    lappend x [eof $f]
    gets $f
    lappend x [eof $f]
    gets $f
    lappend x [eof $f]
    gets $f
    lappend x [eof $f]
    lappend x [eof $f]
    close $f
    set x
} {0 0 0 0 1 1}

test open-12.1 {flush command} {
    list [catch {flush} msg] $msg $errorCode
} {1 {wrong # args: should be "flush fileId"} NONE}
test open-12.2 {flush command} {
    list [catch {flush a b} msg] $msg $errorCode
} {1 {wrong # args: should be "flush fileId"} NONE}
test open-12.3 {flush command} {
    list [catch {flush a} msg] $msg $errorCode
} {1 {bad file identifier "a"} NONE}
test open-12.4 {flush command} {
    set f [open test3]
    set x [list [catch {flush $f} msg] \
        [string range $msg [string first " " $msg] end] $errorCode]
    close $f
    set x
} {1 { wasn't opened for writing} NONE}
test open-12.5 {flush command} {
    set f [open test3 w]
    puts $f "Line 1"
    puts $f "Line 2"
    set f2 [open test3]
    set x {}
    lappend x [read $f2 nonewline]
    close $f2
    flush $f
    set f2 [open test3]
    lappend x [read $f2 nonewline]
    close $f2
    close $f
    set x
} {{} {Line 1
Line 2}}

test open-13.1 {I/O to command pipelines} {
    list [catch {open "| cat < test1 > test3" w} msg] $msg $errorCode
} {1 {can't write input to command: standard input was redirected} NONE}
test open-13.2 {I/O to command pipelines} {
    list [catch {open "| echo > test3" r} msg] $msg $errorCode
} {1 {can't read output from command: standard output was redirected} NONE}
test open-13.3 {I/O to command pipelines} {
    list [catch {open "| echo > test3" r+} msg] $msg $errorCode
} {1 {can't read output from command: standard output was redirected} NONE}
test open-13.4 {writing to command pipelines} {
    exec rm test3
    set f [open "| cat | cat > test3" w]
    puts $f "Line 1"
    puts $f "Line 2"
    close $f
    exec cat test3
} {Line 1
Line 2}
test open-13.5 {reading from command pipelines} {
    set f [open "| cat test2" r]
    set x [list [gets $f] [gets $f] [gets $f]]
    close $f
    set x
} {line1 line2 line3}
test open-13.6 {both reading and writing from/to command pipelines} {
    set f [open "| cat -u" r+]
    puts $f "Line1"
    flush $f
    set x [gets $f]
    close $f
    set x
} {Line1}
test open-13.7 {errors in command pipelines} {
    set f [open "|gorp"]
    list [catch {close $f} msg] $msg [lindex $errorCode 0] [lindex $errorCode 2]
} {1 {couldn't find "gorp" to execute} CHILDSTATUS 1}
test open-13.8 {errors in command pipelines} {
    set f [open "|gorp" w]
    exec sleep 1
    puts $f output
    set x [list [catch {flush $f} msg] [concat \
        [string range $msg 0 [string first {"} $msg]] \
        [string range $msg [string first : $msg] end]] $errorCode]
    catch {close $f}
    string tolower $x
} {1 {error flushing " : broken pipe} {unix epipe {broken pipe}}}
test open-13.9 {errors in command pipelines} {
    set f [open "|gorp" w]
    list [catch {close $f} msg] $msg \
        [lindex $errorCode 0] [lindex $errorCode 2]
} {1 {couldn't find "gorp" to execute} CHILDSTATUS 1}
test open-13.10 {errors in command pipelines} {
    set f [open "|gorp" w]
    exec sleep 1
    puts $f output
    string tolower [list [catch {close $f} msg] [concat \
        [string range $msg 0 [string first {"} $msg]] \
        [string range $msg [string first : $msg] end]] \
        [lindex $errorCode 0] [lindex $errorCode 2]]
} {1 {error closing " : broken pipe
couldn't find "gorp" to execute} childstatus 1}

catch {exec rm -f test1 test2 test3}
concat {}